Developer CD Series 1996 April: Mac OS SDK/Dev.CD Apr 96 SDK/Dev.CD Apr 96 SDK2.toast/Development Kits (Disc 2)/ScriptX/Draggable ScriptX Folders/utils/widgets/widgbase.sx

Text File | 1995-12-06 | 5.1 KB | 187 lines | [TEXT/ttxt]

--<<<
class ColorScheme()
class variables
    grayLevels:#(51,102,136,153,187,204,221)
    grayBrushes
    disableBrush:(new Brush color:BlackColor pattern:@grayPattern)
instance variables
    darkBrush1
    darkBrush2
    lightBrush1
    lightBrush2
class methods
    method afterInit self #rest args -> (
        apply nextMethod self args
        local noOfLevels := (size ColorScheme.grayLevels)
        local grayBrushes := new array initialSize:noOfLevels growable:false
        for i := 1 to noOfLevels do (
            local level := ColorScheme.grayLevels[i]
            local brushColor := new RGBColor red:level green:level blue:level
            grayBrushes[i] := new Brush color:brushColor
        )
        self.grayBrushes := grayBrushes
        self.disableBrush.inkMode := @srcBic
    )
end

method init self { class ColorScheme } #rest args #key BrushIndexArray:(#(3,1,7,5))->
(
    self.darkBrush1 := ColorScheme.grayBrushes[BrushIndexArray[1]]
    self.darkBrush2 := ColorScheme.grayBrushes[BrushIndexArray[2]]
    self.lightBrush1 := ColorScheme.grayBrushes[BrushIndexArray[3]]
    self.lightBrush2 := ColorScheme.grayBrushes[BrushIndexArray[4]]
)

global theBaseScheme := new ColorScheme
global theButtonScheme := new ColorScheme BrushIndexArray:#(3,4,7,6)
global theMenuScheme := new ColorScheme BrushIndexArray:#(1,5,7,5)

class FontContext ()
class vars
    defaultFont
    defaultSize
    defaultLeading
    defaultDescent
instance vars
    fontName,
    fontSize,
    leading,
    descent,
    font
class methods
    method afterInit self #rest args -> (
        apply nextMethod self args
        local fontName
        if (getOne (getpropertylists theSystemManager)[1] @platformNameProp = @PlatformNameMac) then (
            fontName := "Chicago"
            self.defaultSize := 12
            self.defaultLeading := 16
            self.defaultDescent := 4
        ) else (
            fontName := "Arial"
            self.defaultSize := 14
            self.defaultLeading := 15
            self.defaultDescent := 2
        )
        self.defaultFont := new PlatformFont name:fontName
    )
end

method init self { class FontContext } #rest args #key fontName: \
    fontSize:(FontContext.defaultSize) leading: descent:    ->
(
    apply nextMethod self args

    self.fontSize := fontSize
    if (fontName = unsupplied) then (
        self.font := FontContext.defaultFont
        self.leading := FontContext.defaultLeading
        self.descent := FontContext.defaultDescent
        )
    else
        self.font := new PlatformFont name:(fontName)
    self.leading := if (leading == unsupplied) then fontSize + 3 else leading
    self.descent := if (descent == unsupplied) then 3 else descent
)

global theSystemFont := new FontContext
global theAppFont := new FontContext fontName:"Palatino" fontSize:12 leading:14 descent:4

class Frame ()
instance variables
    scheme
    topLeftPath
    botRightPath
end

method init self { class Frame } #rest args #key \
            scheme: (theBaseScheme) \
            boundary:(new rect x2:50 y2:50) ->
(
    self.scheme         := scheme
    setBoundary self boundary
)

method setBoundary self {class Frame} boundary -> (
    local topLeftPath := new Path
    self.topLeftPath := topLeftPath
    MoveTo topLeftPath boundary.x1 (boundary.y2 - 1)
    LineTo topLeftPath boundary.x1 boundary.y1
    LineTo topLeftPath (boundary.x2 - 1) boundary.y1
    local botRightPath := new Path
    self.botRightPath := botRightPath
    MoveTo botRightPath boundary.x1 (boundary.y2 - 1)
    LineTo botRightPath (boundary.x2 - 1) (boundary.y2 - 1)
    LineTo botRightPath (boundary.x2 - 1) boundary.y1
)

method drawLoweredFrame self { class Frame } surface clip transform ->
(
    local scheme := self.scheme
    local topLeftPath := self.topLeftPath
    local botRightPath := self.botRightPath
    translate transform 1 1
    stroke surface topLeftPath clip transform scheme.darkBrush2
    translate transform -2 -2
    stroke surface botRightPath clip transform scheme.lightBrush2
    translate transform 1 1
    stroke surface topLeftPath clip transform scheme.darkBrush1
    stroke surface botRightPath clip transform scheme.lightBrush1
)

method drawRaisedFrame self { class Frame } surface clip transform ->
(
    local scheme := self.scheme
    local topLeftPath := self.topLeftPath
    local botRightPath := self.botRightPath
    translate transform 1 1
    stroke surface topLeftPath clip transform scheme.lightBrush2
    translate transform -2 -2
    stroke surface botRightPath clip transform scheme.darkBrush2
    translate transform 1 1
    stroke surface topLeftPath clip transform scheme.lightBrush1
    stroke surface botRightPath clip transform scheme.darkBrush1
)

function importDIB fileName #key dir:(theScriptDir) ->
(
    local str := getStream dir fileName @readable
    local bm := importMedia theImportExportEngine str @image @DIB @Bitmap
    plug str
    bm
)

function getDblClickTime ->
(
    local plist := newPropertyList Manager
    add plist @SubtypeProp @SubtypePointer

    local qlist := new LinkedList
    append qlist @DoubleClickTimeProp

    local results := query theSysConfigManager  plist qlist

    local doubleClickTime := getFirst results

    if (doubleClickTime = empty) do
        report ShouldntHappen #("No doubleClick value from environment.")

    doubleClickTime
)

function InsetRect r xOffset yOffset todo -> (
    if (todo = @mutate) then (
        r.x1 := r.x1 + xOffset
        r.x2 := r.x2 - xOffset
        r.y1 := r.y1 + yOffset
        r.y2 := r.y2 - yOffset
        r
    )
    else (
        new rect x1:(r.x1 + xOffset) x2:(r.x2 - xOffset) \
            y1:(r.y1 + yOffset) y2:(r.y2 - yOffset)
    )
)

-->>>